home *** CD-ROM | disk | FTP | other *** search
/ Commodore Disc 15 / Commodore_Disc_15_19xx_-_de.d64 / ca - graf (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  16KB  |  342 lines
  1. 0 rem*********  ca - graf  *************
  2. 1 poke157,.:poke53269,.:ifu=.thengosub500:u=.2:load"ca - rout 1",8,1
  3. 2 ifu<.5thenu=.5:load"ca menu ctrl",8,1
  4. 3 ifu<1thenu=1:load"ca - rout 2",8,1
  5. 4 ifu=2thenclose1:printr$:goto10000
  6. 5 ifu=3thenclose1:an=.:al=.:u=2:sys65484:goto10000
  7. 6 ifu=4thensyshd:u=2:goto10000
  8. 7 ifu=5thenclose1:u=2:sys65484:goto10000
  9. 9 ifu=7thensysd2:u=2:sysnm
  10. 10 poke55,.:poke56,76:clr:sys39825:.k,160,100:mp=869:ml=1023:ab=12:poke650,128
  11. 20 open15,8,15:hf=15:zf=.:rf=4:ba=400:mx=160:my=100:t=128:dq=-.001
  12. 30 qx=mx:qy=my:r$=chr$(13):l$=chr$(.)
  13. 40 mv=49244:d2=49374:o=49552:el=49553:h2=49554:hi=49557:hs=49560:be=50236
  14. 50 sp=50290:hd=50348:nm=50378:hk=50446:hx=50486:li=50500:sr=51562:sa=51615
  15. 55 hp=51646:hl=51731:dr=51939:bb=52193:sw=52357:sz=52407:rx=52583:cs=53035
  16. 60 fv=1006:bs=53068:ps=37632:fg=37659:pg=37682:ag=37688:fe=37720
  17. 90 poke792,202:poke793,196:poke65530,231:poke65531,196:poke785,88:poke786,202
  18. 100 dd=37759:hc=39316
  19. 110 bo=53280:ue$="[156][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]":do$=""
  20. 120 b$="          ":sp$=b$+b$+b$+b$:jy=56320:mo$="moment":bw$="bitte warten"
  21. 190 u=2:goto10000
  22. 199 remx/y oder z
  23. 200 printspc(.);:.n,3:b=(peek(243)+256*peek(244)-55296)/40:c=peek(9)-4
  24. 210 print" x / y / z":fori=1to3:.p,i,c+i*4,b,c+i*4+2,b,1:next:.s,14:return
  25. 299 reminput
  26. 300 n$=chr$(34):a$="":b$=chr$(34):print"";
  27. 310 printleft$("[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]",len(n$))n$b$;:wait198,255
  28. 315 iflen(n$)>29thenpoke198,.:wait198,1:ifpeek(631)<>20andpeek(631)<>13then315
  29. 320 geta$:q=asc(a$):ifq<>13andq<>20andq<>34thenn$=n$+a$:goto310
  30. 330 ifq=20andlen(n$)>1thenn$=left$(n$,len(n$)-1):print"[157] [157][157]";:goto310
  31. 340 ifq=20orq=34or(q=13andlen(n$)=1)thenprint"[157]";:goto310
  32. 350 n$=right$(n$,len(n$)-1):return
  33. 399 reminput zahl
  34. 400 print" "spc(.)"[157]";:b=peek(243)+256*peek(244)+peek(9)
  35. 405 printleft$(" ",-(a<.))int(a)"[157]      [157][157][157][157][157][157][157][157][157][157][157][157][157]";
  36. 410 printspc(8-len(str$(int(a)))+(a<.));:waitjy,16:poke198,.:l=.:d$=""
  37. 420 geta$:ifa$=chr$(20)andlthenl=l-1:d$=left$(d$,l):print"[157] [157]";:goto420
  38. 425 ifa$="[133]"thenprintleft$("[157][157][157][157][157][157][157][157][157]",l+1);:goto400
  39. 430 on-(a$=r$or(peek(56320)and16)=.)goto450:on-(a$>"9"ora$>"."anda$<"0")goto420
  40. 440 on-(a$<"-"orl>7)goto420:print"[149]"a$;:l=l+1:d$=d$+a$:ifl>1goto420
  41. 445 print"       [157][157][157][157][157][157][157]";:goto420
  42. 450 printleft$(l$+"",l+1)"[144]"r$;:fori=btob+7:pokei,.:next
  43. 455 b=val(d$):b=b+(b-a)*(l=.):return
  44. 499 remfloppy an?
  45. 500 open1,8,1:close1:ifst=.thenreturn
  46. 510 a=1:gosub900:print"[194]itte [198]loppy einschalten, [198]euer";:gosub700:goto500
  47. 549 remhioff
  48. 550 poke56576,3:poke53272,23:poke53265,27:return
  49. 599 remja/nein
  50. 600 print" "spc(.)"[157]";:b=(peek(243)+256*peek(244)-55296)/40:c=peek(9)
  51. 605 b=b-(c>39):c=c+40*(c>39)
  52. 610 .n,2:.p,1,c-1,b,c+2,b,1:.p,2,c+4,b,c+9,b,1:print" ja / nein":.s,14:return
  53. 699 remfeuer
  54. 700 waitjy,16:waitjy,16,16:poke198,.:return
  55. 799 remfehlerkanal
  56. 800 a=1:gosub900:close1:fori=.to1:printa$;:get#15,a$:i=-(a$=r$):next:goto10300
  57. 899 remuntere leisten
  58. 900 printleft$(do$,22+a*2)"[221]"left$(sp$,38)"[145]";:return
  59. 999 **** zeichnen **********************
  60. 1000 on-(an=.)goto10400:print"[147]"spc(14)"[218]eichnen"spc(30)left$(ue$,13):pokeel,1
  61. 1010 pokeo,224:print"[144]  [206]ormal / [211]chraegbild / [211]uper 3d ?":.n,3:.p,1,1,3,8,3,1
  62. 1020 .p,2,10,3,22,3,1:.p,3,24,3,33,3,1:.s,14:d=st:ae=2:ifd=2goto1080
  63. 1021 print"  [200]idden line ?";:gosub600:ifst=2goto1025
  64. 1022 ae=1:print"  [197]ckpunkte :";:a=an:gosub400:syssa,b,al:sysbb,-mx,-my,.
  65. 1023 sysrx,cos(dq),.,-sin(dq),.,1,.,sin(dq),.,cos(dq):sysbb,mx,my,.
  66. 1024 printspc(20)"[145]("int(al*b*(b-1)/40)"s)"
  67. 1025 d$="  [194]ildschirmabstand :":printd$ba:e$="  [193]uge x :":printe$qx,"y :"qy
  68. 1026 print"  [193]endern ?";:gosub600:onst-1goto1040:printd$;:a=ba:gosub400:ba=b
  69. 1030 printe$;:a=qx:gosub400:qx=b:print"  [193]uge y :";:a=qy:gosub400:qy=b
  70. 1040 syshk,ba,qx+(NULL)^-5,qy+(NULL)^-5:on-(d=3)goto2000:syshi,hf,zf:pokebo,hf+8
  71. 1050 sysdr+(dr-dd)*(ae=1)
  72. 1070 pokebo,rf:gosub700:sysnm
  73. 1080 syshi,hf,zf:pokebo,hf+8:syshk,ba,qx,qy:pokeel,0:sysdr:goto1070
  74. 2000 print"  [193]ugenabstand :";:a=ab:gosub400:ab=b:print"  [212]empo :";:a=t
  75. 2010 gosub400:t=band255:pokesp,t:sysh2,hf,zf:pokebo,h+8:d=dr+(dr-dd)*(ae=1)
  76. 2020 syshx,qx+ab/2+(NULL)^-5:sysd:pokebo,hf+6:syshx,qx-ab/2:pokeo,160:sysd
  77. 2030 pokebo,rf:u=4:sysbe:u=2:goto10000
  78. 2999 **** letztes bild *****************
  79. 3000 print"[147]"spc(14)"[204]etztes [194]ild"spc(26)left$(ue$,17)r$"[144]  [206]eue [198]arben ?";
  80. 3010 a=hf:gosub600:onst-1goto3040
  81. 3020 print"  [200]intergrund :";:gosub400:print"  [218]eichnen :";:hf=band15:a=zf
  82. 3030 gosub400:zf=band15:print"  [210]ahmen :";:a=rf:gosub400:rf=band15
  83. 3040 print"  [211]uper 3d ?";:gosub600:pokeo,224:onst-1goto3080:a=t
  84. 3050 print"  [194]ildwechseltempo :";::gosub400:t=band255:pokesp,t
  85. 3060 syshs,hf,zf:pokebo,rf:u=4:sysbe:u=2:goto10000
  86. 3080 syshs,hf,zf:goto1070
  87. 3999 **** risse ************************
  88. 4000 on-(an=.)goto10400:a=.:gosub900:printmo$:z=usr(1)z
  89. 4030 pokeo,224:fori=2toan:l=usr(i)z:z=z+(z-l)*(z>l):next:pokeel,.:z=z/2-2
  90. 4060 syshi,hf,zf:sysli,mx,.,mx,200:sysli,.,my,320,my:sysrx,.5,.,.,.,.5,.,.,.,.5
  91. 4090 syssr,.,.,mx,my:sysdr:syssr,mx,.,319,my:sysrx,.,.,1,.,1,.,1,.,.
  92. 4100 sysbb,mx-z,.,.:sysdr:sysrx,.,.,1,-1,.,.,.,1,.:syssr,.,my,mx,199
  93. 4110 sysbb,.,360,.:sysdr:sysbb,.,-200-z,.:sysrx,2,.,.,.,.,2,.,-2,.
  94. 4120 pokebo,rf:gosub700:gosub550:goto10400
  95. 4999 **** bilder tauschen **************
  96. 5000 syssw,hf,zf:goto4120
  97. 5999 **** hardcopy *********************
  98. 6000 a=.:gosub900:print"[194]eide [211]creens ?";:gosub600:a=st:open1,4,4:u=5
  99. 6010 pokeel,2-a:ifa=2thenprint#1,""chr$(108)chr$(20);
  100. 6020 cmd1,"3";:syshc:print#1,"@";:close1:goto10300
  101. 9999 **** menue ************************
  102. 10000 pokebo,8:pokebo+1,15:printchr$(8)chr$(14):.r,.,8,308,188
  103. 10010 print"[144][147][149]"left$(sp$,16)"ca - graf"left$(sp$,15)"[146][144]";
  104. 10050 d$="[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]":d$=d$+d$
  105. 10060 print"[176]"left$(d$,12)"[178][192][192][192][192][192][192][192][192][178]"left$(d$,16)"[174][221][210]isszeichng.[221]"spc(8)"[221]  ";
  106. 10070 print"[196]ateneingabe  [221][171]"left$(d$,12)"[179][218]eichnen[221] [196]atenaenderung [221][221]letztes";
  107. 10080 print" [194]ild[221]"spc(8)"[171]"left$(d$,16)"[179][221][194]ildertausch[221]"spc(8)"[221] [207]va";
  108. 10090 print"l / [214]ieleck [221][171][192][192][192][192][192][192][192][192][192][192][178][192][177][192][192][192][192][192][192][192][192][177][178]"left$(d$,15)"[179][221]"spc(10)"[221]";
  109. 10110 printspc(11)"[221]   [214]erzerren   [221][221]  [196]rehen  [221][214]erschieben[171]"left$(d$,15)"[179][221]";
  110. 10150 printspc(10)"[221]"spc(11)"[221][218]entr. [211]trecken[221][171][192][192][192][192][192][192][192][192][192][192][219]"left$(d$,11)"[219]";
  111. 10170 printleft$(d$,15)"[179][221]  [218]irkel  [221]  [203]opieren [221][200]ires speichern[221][171][192][192][192][192][192][192][192][192][192][192][177]";
  112. 10180 print"[192][178][192][192][192][192][192][192][192][192][192][177][192][192][178][192][192][192][192][192][192][192][192][192][192][192][192][179][221][198].[211]tart/[197]nde[221]   [204]aden    [221]  [200]ardcopy";
  113. 10200 print"  [221][221]    [194]ild    [171]"left$(d$,12)"[219]"left$(d$,12)"[179][221]  [198]ilmszene [221]";
  114. 10230 print"   [205]erge    [221] [211]peichern  [221][171]"left$(d$,12)"[219]"left$(d$,12)"[219]";
  115. 10240 printleft$(d$,12)"[179][221]    [198]ilm    [221] [198]ilm laden [221] [196]irectory  [221][221]"spc(12);
  116. 10250 print"[221] [198]ilm merge [171]"left$(d$,12)"[179][221]   [218]eigen   [221][198]. speichern[221]";
  117. 10255 print"[198]loppybefehl[221][171]"left$(d$,12)"[177]"left$(d$,12)"[177]"left$(d$,12)"[179][221]";
  118. 10260 printspc(37)"[221][157][148] [171]"d$"[179][221]"spc(37)"[221][157][148] [173]"d$"[157][189][157][148][192]";
  119. 10300 .n,27:.p,1,1,4,12,4,2:.p,2,14,2,21,5,2:.p,3,23,2,38,2,2:.p,4,1,5,12,5,2
  120. 10302 .p,5,23,3,38,3,2:.p,6,1,2,12,2,2:.p,7,23,5,38,5,2:.p,8,1,7,10,9,2
  121. 10304 .p,9,12,7,22,9,2:.p,10,24,7,38,7,2:.p,11,24,9,38,9,2:.p,12,1,11,10,11,2
  122. 10306 .p,13,12,11,22,11,2:.p,14,24,11,38,11,2:.p,15,1,13,12,13,2
  123. 10308 .p,16,14,13,25,13,2:.p,17,27,13,38,13,2:.p,18,1,14,12,14,2
  124. 10310 .p,19,1,15,12,15,2:.p,20,14,15,25,15,2:.p,21,27,15,38,15,2
  125. 10312 .p,22,1,17,12,19,2:.p,23,14,17,25,17,2:.p,24,27,17,38,17,2
  126. 10314 .p,25,14,18,25,18,2:.p,26,14,19,25,19,2:.p,27,27,19,38,19,2
  127. 10400 pokebo,8:u=2:poke198,.:geta$:syssr,.,.,319,199
  128. 10402 .s,15:ifanthensyshp,.,.,.,.:syssa,an,al
  129. 10410 onstgoto3000,1000,20000,5000,25000,4000,45000,30000,40000,41000,42000
  130. 10420 onst-11goto46000,35000,56000,47000,51000,6000,47500,44000,52000,50000
  131. 10430 onst-21goto48500,49000,54000,49500,48000,55000
  132. 19999 **** koordinateneingabe **********
  133. 20000 print"[147]"spc(10)"[196]aten eingeben"spc(24)left$(ue$,19)
  134. 20010 print"[144]  [206]eue [196]aten eingeben ?";:gosub600:ifst=1thenan=.:al=.
  135. 20040 print"  [194]itte geben [211]ie die [203]oordinaten ein!":a=.
  136. 20050 b$="-[203]oordinate [208]unkt [145]":print"  x"b$an+1":";:gosub400:x=b
  137. 20060 print"  y"b$an+1":";:gosub400:y=b:print"  z"b$an+1":";:gosub400:an=an+1
  138. 20070 syshp,an,x,y,b:on-(an=mp)goto20130:print"  [206]och einen [208]unkt ?[145]";
  139. 20110 gosub600:onstgoto20050
  140. 20130 print"  [202]etzt bitte die [208]unkte eingeben, die    miteinander verbunden ";
  141. 20140 print"werden sollen!":a=1
  142. 20160 al=al+1:print"  [208]unkt 1 ; [204]inie [145]"al":";:gosub400:c=b+1:a=c+(c-1)*(c>an)
  143. 20170 c=b:ifb<1orb>anthenprint"  [197]xsistiert nicht":al=al-1:goto20160
  144. 20180 print"  [208]unkt 2 ; [204]inie [145]"al":";:gosub400:on-(b<1orb>an)goto20170
  145. 20200 syshl,al,c,b:on-(al=ml)goto10000
  146. 20230 print"  [206]och eine [204]inie ?[145]";:a=b:gosub600:onstgoto20160,10000
  147. 24999 **** daten veraendern ************
  148. 25000 print"[147]"spc(13)"[196]aten aendern"spc(25)left$(ue$,18):print"[144]  [208]unkt :"1
  149. 25010 print"  x:"left$(str$(int(usr(1)x)),8)tab(14)"y:";:c$="        [157][157][157][157][157][157][157][157]"
  150. 25020 printleft$(str$(int(usr(1)y)),8)tab(26)"z:"left$(str$(int(usr(1)z)),8)
  151. 25025 print"  [204]inie : 1"r$"  [208]unkt1 :"usr(1)0tab(20)"[208]unkt2 :"usr(1)1
  152. 25030 print"  [193]nzahl [208]unkte :"an;r$"  [193]nzahl [204]inien :"al:p=1:k=1
  153. 25040 geta$:on-(an=.)goto25060:if(peek(jy)and1)=.thenp=p+1+p*(p=an):goto25100
  154. 25050 if(peek(jy)and2)=.thenp=p-1-an*(p=1):goto25100
  155. 25060 on-(al=.)goto25080:if(peek(jy)and8)=.thenk=k+1+k*(k=al):goto25200
  156. 25070 if(peek(jy)and4)=.thenk=k-1-al*(k=1):goto25200
  157. 25080 on-(a$="p")-2*(a$="l")-3*(a$="a")goto25300,25400,25500
  158. 25090 on(peek(jy)and16)/16+1goto10000,25040
  159. 25100 printleft$(do$,7)tab(9)p"[157]  ":printleft$(do$,9)tab(4)c$int(usr(p)x);
  160. 25110 printtab(16)c$int(usr(p)y)tab(28)c$int(usr(p)z):goto25040
  161. 25200 printleft$(do$,12)tab(9)k"[157]  ":printleft$(do$,14)tab(10)c$usr(k)0tab(28);
  162. 25210 printc$usr(k)1:goto25040
  163. 25300 printleft$(do$,9)tab(4);:a=usr(p)x:gosub400:x=b:print"[145]"tab(16);
  164. 25310 a=usr(p)y:gosub400:y=b:print"[145]"tab(28);:a=usr(p)z:gosub400
  165. 25320 syshp,p,x,y,b:goto25040
  166. 25400 printleft$(do$,14)tab(10);:a=usr(k)0:gosub400:x=b:print"[145]"tab(28);
  167. 25410 a=usr(k)1:gosub400:syshl,k,x,b:goto25040
  168. 25500 printleft$(do$,17)tab(17);:a=an:gosub400:on-(b>mp)goto25500:an=b:a=al
  169. 25600 printleft$(do$,20)tab(17);:gosub400:on-(b>ml)goto25600:al=b:goto25040
  170. 29999 **** drehen **********************
  171. 30000 on-(an=.)goto10400:print"[147]"spc(14)"[196]rehen"spc(32)left$(ue$,11)
  172. 30030 print"[144]  [218]u welcher [193]chse soll die [196]rehachse     parallel sein ?";
  173. 30050 a=my:d=.:z$="z":y$="y":gosub200:ifst=3thenz$="y":y$="x":a=mx:d=my
  174. 30060 b$="-[203]oordinate der [193]chse :":ifst=2theny$="x":z$="z":d=.:a=mx
  175. 30080 print"  "y$b$;:gosub400:z=b:print"  "z$b$;:a=d:gosub400:y=b:a=.
  176. 30100 print"  [196]rehwinkel :";:gosub400:w=b/180*(NULL):a=sin(w):b=cos(w)
  177. 30110 printspc(148)mo$:onst-1goto30140,30130
  178. 30120 sysbb,.,-z,-y:sysrx,1,.,.,.,b,a,.,-a,b:sysbb,.,z,y:goto10000
  179. 30130 sysbb,-z,-y,.:sysrx,b,a,.,-a,b,.,.,.,1:sysbb,z,y,.:goto10000
  180. 30140 sysbb,-z,.,-y:sysrx,b,.,-a,.,1,.,a,.,b:sysbb,z,.,y:goto10000
  181. 34999 **** kopieren ********************
  182. 35000 ifan=.oran*2>mporal*2>mlgoto10400
  183. 35010 print"[147]"spc(10)"[203]opieren"spc(30)left$(ue$,13)r$:a=.
  184. 35030 b$="[144]  [214]erschieben - ":printb$"x :";:gosub400:x=b:printb$"y :";:gosub400
  185. 35040 y=b:printb$"z :";:gosub400:z=b:a=1:b$="  [218]erren - ":printr$b$"x :";
  186. 35050 gosub400:vx=b:x=x*b+mx-mx*b:printb$"y :";:gosub400:vy=b:y=y*b+my-my*b
  187. 35060 printb$"z :";:gosub400:vz=b:z=z*b:poke144,2
  188. 35080 on-(2*al+an>ml)goto35102:print"  [203]opien verbinden ?";:gosub600
  189. 35102 printspc(63)bw$:sysrx,vx,.,.,.,vy,.,.,.,vz:sysbb,x,y,z
  190. 35110 fori=1toan:a=usr(i)x:b=usr(i)y:c=usr(i)z:syshp,i+an,a,b,c:next
  191. 35112 sysrx,1/vx,.,.,.,1/vy,.,.,.,1/vz:sysbb,-x/vx,-y/vy,-z/vz
  192. 35120 fori=1toal:a=usr(i)0+an:b=usr(i)1+an:syshl,i+al,a,b:next:al=2*al
  193. 35130 ifst=1thenfori=1toan:syshl,i+al,i,i+an:next:al=al+an
  194. 35140 an=2*an:goto10000
  195. 39999 **** verschieben *****************
  196. 40000 on-(an=.)goto10400:a=.:gosub900:print"x:";:gosub400:print"[145]"spc(13)"y:";
  197. 40010 x=b:gosub400:y=b:print"[145]"spc(26)"z:";:gosub400
  198. 40020 a=1:gosub900:printmo$;:sysbb,x,y,b:gosub900:goto10400
  199. 40999 **** verzerren *******************
  200. 41000 on-(an=.)goto10400:a=.:gosub900:print"x:";:a=1:gosub400
  201. 41010 print"[145]"spc(13)"y:";
  202. 41020 x=b:gosub400:y=b:print"[145]"spc(26)"z:";:gosub400:gosub900:printmo$;
  203. 41030 sysrx,x,.,.,.,y,.,.,.,b:sysbb,mx-mx*x,my-my*y,.:gosub900:goto10400
  204. 41999 **** zentrisches strecken ********
  205. 42000 on-(an=.)goto10400:a=.:gosub900:print"[218]ntr.x:";:a=mx:gosub400:x=b:a=my
  206. 42010 print"[145]"spc(17)"y:";:gosub400:y=b:print"[145]"spc(28)"z:";:a=.:gosub400:z=b
  207. 42020 a=1:gosub900:print"[211]treckfaktor :";:gosub400:print"[145]"spc(26)mo$"[157][157][157][157][157][157]";
  208. 42030 sysrx,b,.,.,.,b,.,.,.,b:sysbb,x-b*x,y-b*y,z-b*z:print"      ";:goto10400
  209. 43999 **** film szene ******************
  210. 44000 ifpeek(152)<2oran=.goto10400
  211. 44010 print"[147]"spc(13)"[198]ilmszene"spc(29)left$(ue$,14)r$"[144]  [214]erschieben:"
  212. 44020 print"  x:";:a=.:gosub400:vx=b:printspc(14)"[145]y:";:gosub400:vy=b
  213. 44030 printspc(26)"[145]z:";:gosub400:vz=b:print"  [214]erzerren:"r$"  x:";:a=1
  214. 44040 gosub400:x3=b:printspc(14)"[145]y:";:gosub400:y3=b:printspc(26)"[145]z:";
  215. 44045 gosub400:z3=b:printleft$(do$,8)"  [196]rehen:":print"  zu x - [193]chse: y:";
  216. 44050 a=my:gosub400:y1=b:printspc(26)"[145]z:";:a=.:gosub400:z1=b:c$="  [215]inkel :"
  217. 44060 printc$;:gosub400:w1=b/180*(NULL):print"  zu y - [193]chse: x:";:a=mx:gosub400
  218. 44070 x1=b:printspc(26)"[145]z:";:a=.:gosub400:z2=b:printc$;:gosub400:w2=b/180*(NULL)
  219. 44080 print"  zu z - [193]chse: x:";:a=mx:gosub400:x2=b:printspc(26)"[145]y:";:a=my
  220. 44090 gosub400:y2=b:printc$;:a=.:gosub400:print"  [214]erschieben der [196]rehachsen:"
  221. 44100 w3=b/180*(NULL):print"  x:";:a=.:gosub400:x=b:printspc(14)"[145]y:";:gosub400:y=b
  222. 44105 printspc(26)"[145]z:";:gosub400:z=b:a=fm/(6*al+1)
  223. 44110 print"  [193]nzahl der [211]chritte :";:gosub400:ae=b:p=an:ifb=.goto10000
  224. 44115 print"  [198]luchtpunkt ?";:gosub600:pokeel,2-st:d=dr+10:ifst=2goto44120
  225. 44116 ifst=1thenprint"  [200]idden line ?";:gosub600:ifst=2goto44120
  226. 44118 d=dd+10:print"  [197]ckpunkte :";:a=an:gosub400:p=b:sysbb,-mx,-my,.
  227. 44119 sysrx,cos(dq),.,-sin(dq),.,1,.,sin(dq),.,cos(dq):sysbb,mx,my,.
  228. 44120 a=cos(w1):w1=sin(w1):b=cos(w2):w2=sin(w2):c=cos(w3):w3=sin(w3):syssz
  229. 44122 vx=x3*(vx-mx)+mx:vy=y3*(vy-my)+my:vz=vz*z3
  230. 44124 m1=x3*b*c:m2=y3*c*w1*w2+y3*a*w3:m3=z3*w1*w3-z3*a*c*w2
  231. 44126 m4=-x3*b*w3:m5=y3*a*c-y3*w1*w2*w3:m6=z3*a*w2*w3+z3*w1*c
  232. 44128 m7=x3*w2:m8=-y3*b*w1:m9=a*b*z3
  233. 44130 pokeo,224:fori=1toae:syshi,hf,zf:print#2,chr$(255);
  234. 44135 pokefv+1,(fm-1)/256:pokefv,fm-1and255:syssa,p,al:sysd:syssa,an,al
  235. 44137 fm=peek(fv)+256*peek(fv+1):fm=fm+2^15*(fm>=2^15):x1=x1+x:y1=y1+y:z1=z1+z
  236. 44140 x2=x2+x:y2=y2+y:z2=z2+z:q=(vx-x1)*b-w2*(w1*(y1-vy)+a*(vz-z1)+z1-z2)+x1-x2
  237. 44150 sysrx,m1,m2,m3,m4,m5,m6,m7,m8,m9
  238. 44155 l=a*(vy-y1)+w1*(vz-z1)+y1-y2:w=q*c+l*w3+x2
  239. 44160 sysbb,w,c*l-q*w3+y2,b*(w1*(y1-vy)+a*(vz-z1)+z1-z2)+(vx-x1)*w2+z2:next
  240. 44180 gosub550:print"[147]":iffm<.thenprint"  [198]ilm zu lang!"
  241. 44190 printspc(2)fm"[198]ilmbytes noch frei.":gosub700:goto10000
  242. 44999 **** oval / vieleck **************
  243. 45000 on-(al<.)goto10400:print"[147]"spc(9)"[207]val / [214]ieleck"spc(24)left$(ue$,19)
  244. 45010 a=24:print"[144]  [215]ieviele [197]cken ?";:gosub400:ifan+b>mporal+b>mlgoto10000
  245. 45020 ae=b:b$=" - [205]itte :":print"  x"b$;:a=mx:gosub400:vx=b:print"  y"b$;
  246. 45030 a=my:gosub400:vy=b:print"  z"b$;:a=.:gosub400:vz=b:w=2*(NULL)/ae
  247. 45040 print"  [194]itte zwei [214]ektoren fuer die"spc(12)"[210]adien eingeben!":a=.
  248. 45050 print"  x1 :";:a=.:gosub400:x=b:printtab(14)"[145]y1 :";:gosub400:y=b:p=.
  249. 45060 printtab(26)"[145]z1 :";:gosub400:z=b:print"  x2 :";:a=y:gosub400:x1=b:a=x
  250. 45080 printtab(14)"[145]y2 :";:gosub400:y1=b:printtab(26)"[145]z2 :";:a=.:gosub400:z1=b
  251. 45110 printspc(103)bw$:fori=.to2*(NULL)-.0001stepw:a=cos(i):b=sin(i):p=p+1:print"[145]"p
  252. 45120 syshp,p+an,vx+a*x+b*x1,vy+a*y+b*y1,vz+a*z+b*z1:syshl,al+p,an+p,an+p+1
  253. 45125 next:syshl,al+ae,an+ae,an+1:an=an+ae:al=al+ae:goto10000
  254. 45999 **** zirkel **********************
  255. 46000 on-(an=.)goto10400:print"[147]"spc(16)"[218]irkel"spc(32)left$(ue$,11)r$"[144]  ";
  256. 46020 print"[218]u welcher [193]chse soll die [205]ittel-       achse parallel sein ?";
  257. 46040 gosub200:z$="y":y$="x":a=mx:c=my:ifst=2thenz$="z":c=.
  258. 46050 b$="-[203]oordinate der [193]chse :":ifst=1thenz$="z":y$="y":a=my:c=.
  259. 46060 print"  "y$b$;:gosub400:z=b:print"  "z$b$;:a=c
  260. 46070 gosub400:y=b:a=mp/an:b=ml/an:a=int(a+(a-b)*(b<a))
  261. 46080 print"  [193]nzahl der [196]rehungen:";:gosub400:ae=b:d=st:ifb<=1orb>agoto10000
  262. 46085 poke144,2:ifb*(al+an)<mlthenprint"  [196]rehungen verbinden ?";:gosub600
  263. 46090 printspc(24)""bw$:ond-1goto46170,46140
  264. 46110 fori=1toae-1:k=i*an:w=i/ae*2*(NULL):a=sin(w):b=cos(w)
  265. 46120 forj=1toan:c=usr(j)y-z:d=usr(j)z-y:x=usr(j)x
  266. 46130 syshp,j+k,x,c*b-d*a+z,c*a+d*b+y:next:next:goto46200
  267. 46140 fori=1toae-1:k=i*an:w=i/ae*2*(NULL):a=sin(w):b=cos(w)
  268. 46150 forj=1toan:c=usr(j)y-y:d=usr(j)x-z:x=usr(j)z
  269. 46160 syshp,j+k,d*b-c*a+z,d*a+c*b+y,x:next:next:goto46200
  270. 46170 fori=1toae-1:k=i*an:w=i/ae*2*(NULL):a=sin(w):b=cos(w)
  271. 46180 forj=1toan:c=usr(j)z-y:d=usr(j)x-z:x=usr(j)y
  272. 46190 syshp,j+k,d*b-c*a+z,x,d*a+c*b+y:next:next
  273. 46200 fori=1toae-1:k=i*al:c=i*an
  274. 46210 forj=1toal:a=usr(j)0:b=usr(j)1:syshl,k+j,c+a,c+b:next:next
  275. 46220 al=al*ae:ifst<>1goto46250
  276. 46230 k=al:fori=.toan-1:forj=.toae-2:syshl,k+j+1,j*an+i+1,j*an+i+an+1:next
  277. 46240 syshl,k+j+1,j*an+i+1,i+1:k=k+ae:next:al=al+an*ae
  278. 46250 an=an*ae:goto10000
  279. 46999 **** film start/ende *************
  280. 47000 a=.:gosub900:onpeek(152)-1goto47100:print"[206]ame :";:gosub300:n$=n$+",p,w"
  281. 47010 open2,8,3,n$:print#2,l$"l";:get#15,a$:fm=16380:close3+(a$>"0"):goto800
  282. 47100 gosub900:print"[211]icher ?";:gosub600:ifst=2goto10300
  283. 47110 print#2,chr$(254);:close2:goto800
  284. 47499 **** bild speichern  *************
  285. 47500 onpeek(152)or-(an=.)goto10400:a=.:gosub900
  286. 47510 print"noch"fm"[198]ilmbytes,<="al*6+1"benoetigt":print"[198]luchtpunkt ?";
  287. 47520 gosub600:pokeel,2-st:d=dr:ifst=2goto47530
  288. 47522 gosub900:print"[200]idden line ?";:gosub600:ifst=2goto47530
  289. 47524 d=dd:a=1:gosub900:print"[197]ckpunkte :";:a=an:gosub400:syssa,b,al
  290. 47530 syssz:syshi,hf,zf:pokeo,224:print#2,chr$(255);:pokefv+1,fm/256
  291. 47540 pokefv,fmand255:sysd+10:fm=peek(fv)+256*peek(fv+1):fm=fm+2^15*(fm>2^15)-1
  292. 47550 goto44180
  293. 47999 **** film speichern  *************
  294. 48000 on(al<.)+1goto10400:a=.:gosub900:print"[206]ame :";:gosub300:a=1:gosub900
  295. 48010 gosub500:print"saving":sysfe:i=peek(253)+256*peek(254)-19456:poke252,76
  296. 48040 poke253,iand255:poke254,i/256:open1,8,1,n$:get#15,a$:ifa$>"0"goto800
  297. 48050 poke251,.:u=5:cmd1,l$"l";:sysps:print#1:u=2:close1:goto800
  298. 48499 **** film zeigen  ****************
  299. 48500 on(al<.)+1goto10400:a=.:gosub900:print"endlos ?";:gosub600:pokebo,rf
  300. 48510 pokeel,2-st:waitjy,16:u=7:sysmv,hf,zf:waitjy,16,16:sysnm
  301. 48999 **** film laden / merge **********
  302. 49000 poke19456,254:al=.:an=.
  303. 49500 p=st:on-(al>-1andst=25)goto10400:a=.:gosub900:print"[206]ame :";:gosub300:a=1
  304. 49510 gosub900:gosub500:print"loading":sysfe:poke251,peek(253):a=.:u=3
  305. 49530 poke252,peek(254):open1,8,.,n$:get#15,a$:on-(a$>"0")goto800:get#1,b$,b$
  306. 49540 poke781,1:sys65478:sysfg:sys65484:gosub900:al=-1:ifpeek(252)>139goto49560
  307. 49550 sysfe:print35840-peek(253)-256*peek(254)"[194]ytes frei.":goto800
  308. 49560 print"[198]ilm zu lang !":close1:pokepeek(253)+256*peek(254),254:al=p=25
  309. 49570 goto800
  310. 49999 **** speichern *******************
  311. 50000 on-(an=.)goto10400:a=.:gosub900:print"[206]ame :";:gosub300:gosub500:a=1
  312. 50020 gosub900:print"saving":open1,8,1,n$+",s,w":get#15,a$:ifa$>"0"goto800
  313. 50040 u=5:cmd1,chr$(anand255)chr$(an/256)chr$(aland255)chr$(al/256);
  314. 50050 sysbs:print#1:u=2:close1:goto800
  315. 50999 ****  laden / merge **************
  316. 51000 al=.:an=.
  317. 52000 al=al-(al=-1):a=.:gosub900:print"[206]ame :";:gosub300:gosub500:a=1:gosub900
  318. 52010 print"loading":open1,8,2,n$+",s,r":get#15,a$:ifa$>"0"goto800
  319. 52030 get#1,a$,b$,c$,d$:a=asc(a$+l$)+256*asc(b$+l$):b=asc(c$+l$)+256*asc(d$+l$)
  320. 52040 on-(an+a>mporal+b>ml)goto52110:u=3:pokeag,4:fori=.to2:c=20485+4352*i+5*an
  321. 52050 poke252,c/256:poke251,c-int(c/256)*256:poke254,a/256:poke253,aand255
  322. 52060 syspg:next:c=33538+al*2:poke253,band255:pokeag,1:poke252,c/256
  323. 52070 poke251,c-int(c/256)*256:poke254,b/256:syspg:poke254,b/256:c=35586+al*2
  324. 52080 poke252,c/256:a$="":poke251,c-int(c/256)*256:poke253,band255:syspg:close1
  325. 52090 ifalthenfori=al+1toal+b:c=usr(i)0+an:d=usr(i)1+an:syshl,i,c,d:next
  326. 52100 al=al+b:an=an+a:goto800
  327. 52110 close1:print"[145]zu viel!":goto10400
  328. 53999 **** directory *******************
  329. 54000 gosub500::open1,8,.,"$":get#15,a$:on-(a$>"0")goto800:print"[147]"
  330. 54010 printtab(6);:fori=.to7:get#1,a$,b$,c$,d$:printa$b$c$d$;:next:print"":f=6
  331. 54020 f=6-f:poke646,f:get#1,a$,a$,a$,b$:printasc(a$+l$)+256*asc(b$+l$);
  332. 54030 fori=.to3:get#1,a$,b$,c$,d$,e$,f$,g$:printa$b$c$d$e$f$g$;:next
  333. 54040 waitjy,16:print:on-(st=.)goto54020:close1:gosub700:goto10000
  334. 54999 **** disk-kommando ***************
  335. 55000 a=.:gosub900:print"?";:gosub300:gosub500:print#15,n$:get#15,a$:goto800
  336. 55999 **** hires speichern *************
  337. 56000 a=.:gosub900:print"[206]ame :";:gosub300:a=1:gosub900:syssw,15,.:gosub550
  338. 56010 open1,8,1,n$+",p,w":get#15,a$:ifa$>"0"goto800
  339. 56020 poke251,.:poke252,160:print#1,chr$(0)chr$(32);:print"saving":syscs
  340. 56030 close1:syssw,15,.:gosub550:goto800
  341. 63999 *  (w) 1986 by fridtjof siebert  *
  342.